perm filename S2Z.F4[P11,LCS] blob
sn#400673 filedate 1979-01-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE READIT
C00025 00003 101 N=INP(ML)
C00049 00004 1106 KTMP=1
C00057 ENDMK
C⊗;
SUBROUTINE READIT
C11 DOUBLE PRECISION J,ITEMP,IRUN,IEDIT,IPRECE,INSER,IPLAY,
C11 1 ISECTI,IEND,IFINI,JEND
COMMON /PCIP/ PCH(27,102),IPT(27,101) /ERRFLG/ERRFLG
COMMON/P/P(1) /PL/PL(1) /COPY/NUMP
COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,JED /NAMES/NA(100),LETRS(27),JNAM(27)
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
COMMON /VV/LIMIT,V(1) /A/ROFF(27),NP(27)
1,RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
1 ,INVIS(27)
DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON J,L,CNT(27),BT,MK,SUB,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,INSNUM,NNUM,JJ,JA,ISUB,NFLG,
1 IXX,ISEMI,IQT
1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
1 ,(ISS,ISCA(9)),(ITT,ISCA(11)),(ICC,ISCA(1)),(NINE,IDAT(10))
1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8)),(IZERO,IDAT(1))
DATA KSLA/'/'/,III/'I'/,IEN/'N'/,ITMPO/'TEMP'/
1,J80/'80'/,JA1/'A1'/,LRTPAR/')'/,LY/'Y'/,LR/'R'/,LU/'U'/
1,ICOM/','/,IEXP/'!'/,INUM/'#'/,IANPRS/'&'/,IDBLQ/'"'/,
1ILESS/'<'/,IQUES/'?'/,IPERC/'%'/,LFTPAR/'('/,LDOL/'$'/,
1MINUS/'-'/,IEM/'M'/,IEL/'L'/,IRUN/'RUN;'/,INSER/'INSE'/
1,IPRECE/'PREC'/,IEDIT/'EDIT'/,IPLAY/'PLAY'/,IEND/'END '/,
1ISECTI/'SECT'/,IFINI/'FINI'/,IAT/'@'/,LQ/'Q'/,IASTR/'*'/,
1ASTR/'*'/,JEND/'END;'/
C *************** READS INPUT ***********************
ERRFLG=0
KIMIT=LIMIT-100
C FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
ICHD=0
2308 IF(ITYP)GO TO 2127
2200 FORMAT(' TYPE INST NAME, ETC'/)
23081 TYPE 2200
ACCEPT 77732,JNP
CKL IF(JNP(1).EQ.' ')GO TO 23081
CHECK FOR TAB
77732 FORMAT(80A1)
IF(JED)CALL COLTTY(JNP,21)
CKL JFM(4)='80A1)'
JFM(4)='80A1)'
C PUTS ON LPT AND TTY
GO TO 1074
2127 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
C******441 JFM(4)=J80A1
IF(LN.EQ.0)GO TO 1074
CKL JFM(1)=' (I,A'
JFM(1)=' (I,A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,LN,J,JNP
GO TO 4127
CKL 1074 IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 2308
1074 IF(INP1.EQ.IBLA.OR.INP1.EQ.ILESS)GO TO 2308
C ABOVE FOR COMMENTS
CKL JFM(1)=' (A'
JFM(1)=' (A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,J,JNP
4127 IF(JED)GO TO 41271
IF(K.EQ.LY)GO TO 41271
C K CHECK IS TO PASS AFTER RETYPING
2202 FORMAT(' RETYPE LINE?'/)
TYPE 2202
ACCEPT 77732,K
CKL CALL LO2UP(K)
IF(K.EQ.LY)GO TO 23081
IF(K.EQ.IG)JED=-1
41271 IF(J.EQ.IBLA)GO TO 2308
CHECKS FOR SPACE(IBLA)
CKL CALL LO2UP(J)
C MAKE SURE INST NAME, ETC. IS UPPER CASE.
LLETRS=MLX
C LETRS FOR NAME CHANGE FEATURE AT 104
MLX=1
IZ=0
JA=-1
ISUB=4
CALL CLEAN(LEND)
C CLEANS OUT = AND , AND FINDS LINE LENGTH.
ALL=1.
VX1=0
VX2=0
VX3=0
INSNUM=-1
K=0
JRSTA=0
IOFSET=0
C** IOFSET IS FOR 'CONTINUATION PARAMETERS' - SO INPUT P'S MATCH INST.
C** CAUTION!!! ANY 'OFFSET' PARAMS THAT ARE REFERRED TO AFTER AN 'END'
C** MUST USE THE PROPER INTERNAL NUMB. OF SCORE, NOT THE INST. PARAM!!!!!
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,LEND
N=INP(JD)
IF(N.NE.LR)GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,LEND
KL=INP(M)
IF(KL.EQ.IBLA)GO TO 3631
IF(KL.EQ.ISEMI)GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
JRSTA=J
GO TO 362
363 CONTINUE
361 IF(N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J)GO TO 6773
IF(IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
INSNUM=K
GO TO 1773
36 IF(J.EQ.IRUN)CALL RUNIT
CKL 36 IF(J.EQ.'RUN;')GO TO 197
CKL IF(J.NE.'RUN')GO TO 97
CKL197 CALL RUNIT
97 IF(J.EQ.INSER)GO TO 397
IF(J.EQ.IPRECE)GO TO 397
IF(J.NE.IEDIT)GO TO 297
CKL97 IF(J.EQ.'INSER')GO TO 397
CKL IF(J.EQ.'PRECE')GO TO 397
CKL IF(J.NE.'EDIT')GO TO 297
397 ISUB=6
297 IF(ISUB.GT.4)GO TO 1773
IF(J.EQ.ITMPO)GO TO 1773
CKL IF(J.EQ.'CONDU')GO TO 1773
IF(J.EQ.IPLAY)GO TO 1773
IF(J.EQ.ISECTI)GO TO 1081
CKL IF(J.EQ.'PLAY')GO TO 1773
CKL IF(J.EQ.'SECTI')GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.IEND)GO TO 1082
IF(J.EQ.IFINI)GO TO 1082
CKL IF(J.EQ.'END')GO TO 1082
CKL IF(J.EQ.'END S')GO TO 1082
CKL IF(J.EQ.'FINIS')GO TO 1082
362 INSNUM=NINS+1
IF(INSNUM.GT.KZY)CALL ERR(7)
INST(INSNUM)=J
LETRS(INSNUM)=LLETRS
C SAVE HOW MANY LETTERS IN INST. NAME (FOR 'RUNIT')
IZ=INSNUM
GO TO 1773
C*********** DOWN TO 8001 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
C****** OR 80 ↑↑↑↑↑↑↑↑↑ ?????
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
8001 FORMAT(A5,5F)
107 FORMAT(I,A5,5F)
4 IF(INSNUM.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(INSNUM)=VX1
IDALL=INSNUM
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(INSNUM)=VX1
IF(INSNUM.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=INSNUM
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(INSNUM)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.EQ.0)GO TO 900
C 2 NUMBS HERE MEAN START ON NOTE NUM.VX2 OF INST.VX1
IF(VX1.EQ.0)VX1=INSNUM
C VX1=0 MEANS USE NUMB. OF THIS INST.
VX1=VX1*10000.+VX2
900 IF(VX1.NE.BY)GO TO 497
IF(J.NE.IPLAY)GO TO 5773
CKL IF(J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
497 BY=VX1
C BY=CURRENT BG TIME.
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(JRSTA.EQ.0)GO TO 3173
DO 173 K=NINS-1,1,-1
173 IF(JRSTA.EQ.INST(K))GO TO 1173
1173 VX1=K
GO TO 7720
C GO DO A 'DUPL'
2173 JRSTA=0
3173 IF(J.EQ.ITMPO)GO TO 1106
CKL IF(J.EQ.'CONDU')GO TO 3018
IF(J.EQ.IPLAY)GO TO 1083
CKL IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
ML=MLX
IF(I.LT.KIMIT)GO TO 774
TYPE 107,I
IF(I.GE.LIMIT)TYPE 1774
1774 FORMAT(/' ******* TOO MUCH INPUT DATA!! USE "MIXSCR" *******'/)
774 ALL=1.
SUB=0
ISUB=1
1299 IF(MLX.LE.LEND)GO TO 1773
7773 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
IF(INP1.EQ.IBLA.OR.INP1.EQ.ILESS)GO TO 7773
C ABOVE FOR COMMENTS. BIG NUM = '<'
IF(JED)GO TO 77733
TYPE 2202
ACCEPT 77732,K
CALL LO2UP(K)
IF(K.NE.LY)GO TO 442
2203 FORMAT(' TYPE A LINE'/)
TYPE 2203
ACCEPT 77732,JNP
442 IF(K.EQ.IG)JED=-1
C DOESN'T WORK FOR EDITS AND INSERTS YET???
77733 MLX=1
C FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
CALL CLEAN(LEND)
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(QTS.GE.0)GO TO 597
IF(V(I-1).EQ.999.)L=L-1
597 IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
CC17732 JZ=0
17732 N=0
17731 ML=MLX
C BIG LOOP -- TO END OF PAGE 1.
JPP=-1
C FOR OLD 'DF' STUFF. CHECKS FOR A Pn
JD=ML
975 N=INP(JD)
IF(N.EQ.IBLA)GO TO 236
IF(N.EQ.IPP)JPP=0
C FOUND 'P'
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.EQ.LFTPAR)GO TO 697
IF(N.NE.LRTPAR)GO TO 2361
697 INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.LRTPAR)GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)CALL ERR(3)
MOT=LCNT-1
1140 DO 11401 JC=1,LCNT-1,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
TYPE 11402,INP(L)
11402 FORMAT(' ****** MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
C ''''''' FOR SINGLE QUOTES
3361 IPRN=IPRN+1
GO TO 236
C JUMPS BACK INTO QUOTE SECTION
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(N.NE.':')GO TO 2362
ICHD=ICHD+1
N=KSLA
GO TO 336
2362 IF(N.NE.IAT)GO TO 5361
DO 113 L=1,LEND
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.MINUS)GO TO 6113
IF(CODE.EQ.-88.)CALL ERR(8)
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.LDOL)GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
IF(CODE.EQ.-88.)CALL ERR(8)
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 JMOT=1,LCNT,3
IF(JG.NE.LIST(JMOT))GO TO 6361
VX1=0
DO 40 M=JD+2,LEND
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
IF(JG.EQ.KSLA)GO TO 140
IF(JG.EQ.ISEMI)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(JMOT+1)
M=LIST(JMOT+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
C INVERSIONS NEXT
840 X=V(KN)
IF(X.GT.-9999.)GO TO 841
C CAN'T INVERT A 'P' NUMBER.
Z=X
GO TO 941
841 RB=X
X=ABS(X)+VX1
Z=X
IF(RB)Z=-Z
941 V(I)=Z
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
KN=KN+JC
IF(V(KN-JC).NE.199.)GO TO 940
C 199. IS NOW NUM. FOR 'R' (REST) 7/78
V(I-1)=199.
GO TO 840
940 Z=V(KN)
IF(Z.LT.-9999.)GO TO 540
C CAN'T INVERT OR TRANSPOSE 'P' NUMBERS.
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.(NO LIT)
IF(CODE.EQ.-88.)CALL ERR(8)
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.199.)GO TO 540
C 199. IS NOW NUM. FOR 'R' (REST) 7/78
Y=0
RB=VX1
IF(Z)RB=-RB
IF(INVRT)GO TO 541
RB=-RB
RC=X
C X IS SET FURTHER BACK.
IF(Z)RC=-RC
C THIS STUFF FOR CHORD FEATURE
Y=(RC-Z)*2
541 Z=Z+RB+Y
Y=ABS(Z)
IF(Y.LT.1.OR.Y.GT.108)CALL ERR(8)
C ERROR IF TRANSP. HAS PUSHED A NOTE NUMBER TOO HIGH OR TOO LOW.
V(I)=Z
GO TO 7361
540 V(I)=Z
7361 IF(JC.GT.0)GO TO 543
IF(CODE.NE.-33)GO TO 543
JG=I
IF(V(I).GT.0)GO TO 543
542 Y=V(JG)
V(JG)=V(JG-1)
V(JG-1)=Y
C THIS STUFF FOR CHORD FEATURE
IF(V(JG-2).GT.0)GO TO 543
JG=JG-1
GO TO 542
543 I=I+1
IZ=IZ+1
C IZ USED FOR INTERNAL TEMPO FEATURE (FIXED 6/78)
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
DO 8361 L=JD,LEND
JG=INP(L)
KN=L
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.LRTPAR)IPRN=IPRN+1
IF(JG.NE.ISEMI)GO TO 8361
IAMP=-1
GO TO 9361
8361 CONTINUE
C ABOVE 4 LINES PUT IN 8/76. REPLACE C*********** ↓↓
9361 MLX=L+1
IF(L.GE.LEND)GO TO 93612
IF(IAMP.NE.0)GO TO 797
IF(QTS)GO TO 1773
C GO BACK IF NOT END OF LINE
797 JZ=-1
93612 IF(IAMP.EQ.0)GO TO 93611
IF(QTS)GO TO 9004
GO TO 2722
C THESE ARE FOR "LIT" ITEMS
C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
93611 IF(KN.EQ.LEND)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
GO TO 236
C LAST TIME FOR QUOTES
C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
C JUMPS TO END STRING OF QUOTES
6361 CONTINUE
CALL ERR(0)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.EQ.LDOL)CALL ERR(8)
C FOUND $ BUT NO @!
INPX=INP(JD+1)
53611 IF(N.NE.ISS)GO TO 53612
IF(INPX.NE.LU)GO TO 53612
SUB=SUB-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.IEM)GO TO 612
IF(INPX.NE.III)GO TO 612
SUB=SUB-200.5
C THE '.5' CALLS 'MICRO' RATHER THAN 'SUBR'.
GO TO 43615
612 IF(N.NE.IAA)GO TO 43611
C FINDS 'ALL'.
IF(INPX.NE.IEL)GO TO 236
ALL=-1.
GO TO 43615
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
C BEFORE! QUAD (IF USED).
C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611 IF(N.NE.LQ)GO TO 4361
IF(INPX.NE.LU)GO TO 4361
QX=-13.
DO 43612 N=JD,LEND
J=INP(N)
IF(J.EQ.IXX)QX=QX-1.
IF(J.EQ.IF)QX=QX-2.
IF(J.EQ.IBLA)GO TO 236
IF(J.EQ.KSLA)GO TO 236
43612 INP(N)=IBLA
4361 IF(N.NE.III)GO TO 43613
IF(ISUB.NE.4)GO TO 43613
C -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C -3= BOTH BEGINNING AND END ARE INVIS.
C THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
L=-1
IF(INPX.EQ.IE)L=L-1
INVIS(INSNUM)=INVIS(INSNUM)+L
43615 DO 43614 L=JD,LEND
N=INP(L)
IF(N.EQ.IBLA)GO TO 236
IF(N.EQ.ISEMI)GO TO 236
43614 INP(L)=IBLA
43613 IF(N.NE.KSLA)GO TO 1336
IF(JD.GE.LEND-1)JZ=0
C SO IT WILL READ NEXT LINE.
GO TO 336
1336 IF(N.NE.ISEMI)GO TO 936
IAMP=-1
336 MLX=JD+1
IF(ISUB.GE.104)GO TO 104
IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
936 IF(N.NE.IDOT)GO TO 136
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22..OR.CODE.EQ.-23.)INP(JD)=1
GO TO 236
136 IF(N.NE.IQT)GO TO 236
DO 1361 K=JD+1,LEND
IF(INP(K).NE.IQT)GO TO 1361
JD=K+1
GO TO 975
C SKIPS MATERIAL IN QUOTES
1361 CONTINUE
CALL ERR(0)
C OPEN QUOTES
236 JD=JD+1
IF(JD.LE.LEND)GO TO 975
CALL ERR(1)
1899 CALL SCANR
GO TO(1,2,3,4,5,6),ISUB
101 N=INP(ML)
IZ=ML
ML=ML+1
IF(N.EQ.IBLA)GO TO 101
M=1
JA=-1
C AT THIS POINT IT LOOKS FOR P=PARM, E=END, D=DUPL, C=CONTINUATION, R=RUN.
IF(N.EQ.IPP)GO TO 1
IF(N.EQ.IE)GO TO 2308
IF(N.NE.LR)GO TO 1101
N=INP(ML)
C 'RUN' MAY REPLACE 'END' FOR LAST INST.
IF(N.EQ.LU)CALL RUNIT
LPAR=1
C TYPE 'RD' (P1) FOR RANDOM DEVIATION, 'RR'(P100) FOR RANDOM RESTS.
IF(N.NE.LR)LPAR=NUMP+1
1205 K=ML
205 K=K+1
IJ=INP(K)
IF(IJ.EQ.IBLA)GO TO 205
IF(IJ.NE.IDOT.AND.IJ.NE.MINUS.AND.
1 IJ.NE.IPP.AND.(IJ.LT.IZERO.OR.IJ.GT.NINE))CALL ERR(0)
C LOOK FOR ILLEGAL FORMAT WITH RR, RD, DF. (ACCEPTS NUM,DOT,Pn,MINUS)
GO TO 201
1101 IF(N.NE.ID)GO TO 303
IF(INP(ML).NE.IF)GO TO 7720
C NEXT FOR 'DF' DUTY FACTOR IN PLACE OF A Pn. (TAKE OUT OLD DF STUFF LATER.)
C IEM IS USED AFTER 897 INSTEAD OF 'ML'
LPAR=NUMP+2
C USE P101 FOR DF.
GO TO 1205
303 IF(N.NE.ICC)CALL ERR(0)
C NEXT FOR 'CONTINUATION'. AUTOMATICALLY PUSHES UP PARAM NUMS.
IOFSET=IOFSET+1
LPAR=IOLDPR+IOFSET
TYPE 1201,IOFSET
IF(LPAR.GT.NUMP)CALL ERR(6)
2201 IF(INP(ML).EQ.IBLA)GO TO 3201
C TO MOVE POINTER AHEAD. MUST HAVE BLANK AFTER ICC OR 'CO' OR 'CONT', ETC.
ML=ML+1
GO TO 2201
3201 IZ=ML-1
M=0
GO TO 201
1201 FORMAT(' →→→→→→ REMEMBER →→→→→ PARAMETER OFFSET=',I2)
1 CALL SCANR
IOLDPR=VX1
C SAVE PARAM NUM. FOR POSSIBLE 'CONTINUATION'. BEWARE OF >P30!!!!
LPAR=IOLDPR
C******* IF(LPAR.GT.30)GO TO 201
IF(LPAR.GT.NUMP)GO TO 201
LPAR=LPAR+IOFSET
IF(LPAR.GT.NUMP)CALL ERR(6)
C******* IF(LPAR.GT.30)CALL ERR(6)
201 IJ=LPAR
IF(IJ.GT.NUMP+2)CALL ERR(6)
C************** IF(IJ.GT.32)CALL ERR(6)
CATCHES PARAM. OUT OF RANGE.
IF(QX.GE.0)GO TO 5703
IJ=LPAR+4
C SETS UP PARAM FOR QUAD CALL
V(I)=IJ+INSNUM*10000
V(I+1)=2*ALL
C TEST "ALL" FEATURE HERE!!!!!!!
C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
V(I+2)=QX
I=I+3
QX=0.
5703 IAMP=0
IF(IJ.LE.NP(INSNUM))GO TO 897
IF(IJ.LE.NUMP)NP(INSNUM)=IJ
897 V(I)=LPAR+INSNUM*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
C QU=QUADC QUX=QUADX
5702 ML=ML+1
CC IF(ML.GT.72)GO TO 99
N=INP(ML)
IF(N.EQ.IBLA)GO TO 5702
IF(N.EQ.ICOM)GO TO 5702
NL=INP(ML+1)
JA=-1
ISUB=0
IF(N.EQ.IXX)GO TO 2703
IF(N.EQ.LR)GO TO 6702
IF(N.EQ.IF)GO TO 8702
IF(N.EQ.IPP)GO TO 7006
IF(N.EQ.ID)GO TO 3702
IF(N.NE.ICC)GO TO 4005
IF(NL.EQ.LU)GO TO 7006
C FOR 'CUTOFF'
4005 JA=0
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.IEM)GO TO 703
IF(N.EQ.IEL)GO TO 2720
IF(N.EQ.ISS)GO TO 6703
CKL IF(N.EQ.ITT)GO TO 4018
IF(N.EQ.IQT)GO TO 5720
IF(N.EQ.ISEMI)GO TO 2018
C 7/75 IF(N.EQ.IPP)JA=-1
C FOR ;P5 P3;
7006 CALL SCANR
IF(ISUB.EQ.8)GO TO 8
I=I+JJ
V(IJ+1)=NNUM+SUB
IF(JJ.EQ.1)GO TO 4006
C IF NNUM IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
IX=IJ+3
DO 2006 K=2,JJ,3
2006 CALL RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5006 IX=IJ+2
DO 6006 K=1,JJ
6006 V(IX+K)=VX(K)
IF(NL.EQ.LU)GO TO 8006
C JUMP FOR 'CUTOFF'
IF(MOD(JJ,3).NE.0)CALL ERR(12)
V(IX+JJ-2)=1.
C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
GO TO 3013
CCCC NOW DONE IN 'SCANR' 7/78 4006 IF(JA)VX1=-VX1/100.-9999.
C CHANGES ;P5 P3; TO ;P5 -9999.03; ***** CHECK OUT ON OTHER MACHINES!
CIRC4006 IF(JA)VX1=VX1/100.+9999.
CIRC CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
4006 V(I-1)=VX1
GO TO 3013
8006 V(IJ+1)=-19
C FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
GO TO 3013
6702 IF(NL.EQ.IE)GO TO 2703
C JUMP IF "REP"
CKL IF(NL.EQ.ITT)GO TO 4018
C JUMP IF "RTAP"
IF(NL.EQ.LR)GO TO 702
C RR=RAN. RESTS
IF(NL.EQ.ID)GO TO 1702
C RD=RAN. DEV. OF P1
CODE=-22
IF(NL.EQ.IEL)CODE=-46.0
C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
IF(NL.NE.IEN)GO TO 1016
C JUMP IF NOT "RNOTES"
JA=0
C FOR SCANR
CODE=-36.
GO TO 1016
702 K=100
C PARAM CODE FOR RAN. RESTS
GO TO 2702
1702 K=1
C PARAM CODE FOR RAN. DEV.
GO TO 2702
3702 IF(NL.NE.IF)GO TO 4005
K=101
C PARAM CODE FOR DUTY FAC.
2702 V(I+1)=V(I-4)
C SHIFT STUFF AROUND
V(I-4)=INSNUM*10000+K
V(I-3)=4.
V(I-2)=-1.
V(I-1)=1.
V(I)=-9999.0-LPAR/100.0
I=I+5
IJ=IJ+5
ML=ML+1
GO TO 5702
6005 CODE=-33
IF(NL.EQ.IAA)GO TO 2721
C NUMS, NOTES, NAMES.
IF(NL.NE.LU)GO TO 1016
CODE=-44.
1610 JA=-1
GO TO 1016
8702 CODE=-35
IF(NL.EQ.LU)GO TO 1016
ML=ML+1
CALL SCANR
7 V(IJ+1)=CODE+SUB
V(IJ+2)=1.
IF(VX1.GT.99)CALL ERR(4)
C TRAPS F NUMS >99.
V(I)=VX1+200.
GO TO 7703
C******** MOVE IS NEXT ***********
703 BW=V(IJ-2)
IC=0
DO 7031 K=ML+1,LEND
LP=INP(K)
IF(LP.EQ.KSLA)GO TO 8031
IF(LP.EQ.IPP)IC=1
C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
7031 IF(LP.EQ.IXX)IC=-1
C IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
8031 I=I-1
V(I)=0
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(INSNUM)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-9900.-X
ISUB=2
IZ=-1
C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703 GO TO 1299
102 IF(IZ.LT.0)GO TO 2102
C SKIPS NEXT FIRST TIME
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=(JJ+2)*ALL
V(I+3)=CODE+SUB
I=I+4
IZ=1
2102 IF(BW.LT.10000.)CALL BGSORT(BW)
C ROUND-OFF NONSENSE
2 VX3=-9900.
VX2=VX3
CALL SCANR
IF(JJ.GT.0)GO TO 5102
JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
DO 6102 K=1,JJ
6102 VX(K)=VX(K+20)
GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102 IF(JJ.EQ.4)CALL ERR(9)
C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=(JJ+2)*ALL
C WORD COUNT
CODE=-55.
IF(JJ.NE.3)CODE=-57.
IF(NFLG)CODE=CODE-1.
IF(IC)CODE=-59.
C CODE=-56 OR -58 FOR NOTES.
V(IJ+1)=CODE+SUB
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CALL RANR(VX,2)
IF(JJ.NE.3)CALL RANR(VX,4)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 IF(IC.LE.0)GO TO 3003
C NEXT FOR 'MOVP', MOVE FROM PARAM TO PARAM.
DO 1003 K=2,JJ
1003 VX(K)=-VX(K)/100.0-19999.0
C CHANGES PARAM NUMS TO MAGIC NUMS.
3003 ICT=I
ILIT=JJ
C SAVES FOR SLASH REPEAT FEATURE
IJ=IJ+1
DO 1006 K=1,JJ
VX(20+K)=VX(K)
C SAVES FOR SLASH REPEAT FEATURE
1006 V(IJ+K)=VX(K)
I=I+JJ
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
GO TO 8703
7703 V(IJ)=4.*ALL
8703 I=I+1
GO TO 4773
C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
6703 CODE=-12.
IF(INP(ML+3).EQ.IEL)CODE=-11.
V(IJ)=2.*ALL
V(IJ+1)=CODE+SUB
I=I-1
GO TO 4773
CKL4018 CNT(INSNUM)=-9900.-BY
CKL P(INSNUM)=V(I-4)
CC 6/74 COLGATE JREAD=3
CC 6/74 COLGATE GO TO 4400
CKL1444 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
CKL443 IF(LN.NE.0)REREAD 107,K,IPT(INSNUM,1)
CKL IF(LN.EQ.0)REREAD 8001,IPT(INSNUM,1)
C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
CKL IF(J.EQ.'CONDU')GO TO 444
CKL IF(NL.NE.ITT)GO TO 2338
CKL CODE=-23.
CKL GO TO 1016
CKL2338 I=I-4
CKL GO TO 4773
CKL3018 CNT(KZY)=-9900.
CKL INSNUM=KZY
C TO PUT 'CONDUCT' FILE NAME IN LAST SLOT (KZY) AT 443
CKL GO TO 1444
CKL444 P(KZY)=980000.
CKL GO TO 2308
C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C 'REP'
2703 ML=ML+1
VX1=0
VX2=0
VX3=0
IF(N.EQ.IXX)GO TO 2704
INP(ML)=IBLA
INP(ML+1)=IBLA
C WIPES OUT 'EP' IN 'REP'
2704 CALL SCANR
V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=INSNUM-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(INSNUM).LT.0)DUR(INSNUM)=DUR(KL)
IF(VX3.EQ.0)GO TO 4773
L=VX3
ML=INSNUM+1
DO 1018 KL=ML,L
IF(LPAR.LE.NP(KL))GO TO 997
IF(LPAR.LT.31)NP(KL)=LPAR
997 IF(DUR(KL))DUR(KL)=DUR(INSNUM)
C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
1018 I=I+4
GO TO 4773
2018 IF(SUB.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
V(IJ+1)=-201.
V(IJ+2)=1.
V(IJ+3)=0
GO TO 7703
20181 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+INSNUM*10000
GO TO 4773
C READS /P5 .3 "ABC" .7 "XYZ"/
8 IF(MOD(JJ,2).NE.0)CALL ERR(12)
IF(LPAR.EQ.2)CALL ERR(13)
V(IJ+1)=-77.+SUB
C SUB HAS SUBR CALL INFO
I=I+1
VX(JJ-1)=1
C FOR RAND. SINGLE LITS.
DO 3722 K=1,JJ,2
V(I)=VX(K)
3722 I=I+1
V(IJ+2)=JJ/2
V(IJ+3)=I
DO 4722 K=2,JJ,2
KN=I
I=I+1
L=VX(K)
DO 6722 KL=L,LEND
IF(INP(KL).EQ.IQT)GO TO 4722
IV(I)=INP(KL)
6722 I=I+1
4722 V(KN)=I-KN-1
V(IJ)=(I-IJ)*ALL
GO TO 4773
2720 QTS=0
2721 ISUB=104
IF(NL.EQ.IAA)ISUB=ISUB+1
GO TO 1299
104 IF(ISUB.EQ.104)GO TO 1041
C NEXT FOR INST NAME CHANGES. Pn NAMES/N;
C V LIST= n000n/WDCNT/-89/NUM OF DUPLS/INST NAME/NUM OF LETTERS IN NAME/
C *********** NO 'ALL' OR 'DUPL' FEATURES WITH NAMES **************
V(IJ)=5
V(IJ+1)=-89
CALL SCANR
V(I-1)=VX1
IV(I)=INST(INSNUM)
CXX IV(I+1)=2**(1+(7-LETRS)*7)
I=I+2
GO TO 4773
1041 KL=0
CODE=-88.
DO 6721 K=ML,LEND
L=INP(K)
IF(L.EQ.IBLA)GO TO 6721
JC=K+1
IF(L.EQ.IQT)GO TO 7721
IF(L.EQ.KSLA)GO TO 7232
IF(L.EQ.ISEMI)GO TO 7232
IF(L.NE.IF)GO TO 1040
IF(INP(K+1).NE.III)GO TO 1040
IF(INP(K+2).NE.IEN)GO TO 1040
IF(INP(K+3).NE.IE)GO TO 1040
C FINDS THE WORD "FINE".
V(I)=-10000.
IF(DUR(INSNUM))DUR(INSNUM)=10000
GO TO 1042
1040 IF(L.EQ.IPERC)INP(K)=KSLA
IF(L.EQ.IQUES)INP(K)=ISEMI
IF(L.EQ.IEXP)INP(K)=ICOM
IF(L.EQ.INUM)INP(K)=ILESS
IF(L.EQ.IANPRS)INP(K)=IDBLQ
C THE ABOVE ARE ALL SPECIAL CHAR'S TO AVOID VARIOUS CONFUSIONS.
IF(KL.EQ.0)KL=K
6721 CONTINUE
C FOR REPEAT OF ITEM BY SLASH
C KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
7232 IF(KL.EQ.0)GO TO 7233
JC=KL
ML=K+1
JD=K-1
NLIT=K-KL
GO TO 8721
7233 DO 7230 KL=ILIT,ILIT+NLIT
V(I)=V(KL)
7230 I=I+1
GO TO 27222
7231 CONTINUE
5720 IAMP=-1
JC=ML+1
C FOR SINGLE 'LIT' ITEMS.
7721 DO 1722 KL=JC+1,LEND
IF(INP(KL).NE.IQT)GO TO 1722
JD=KL-1
ML=KL+1
NLIT=KL-JC
C EXTENT OF LIT ITEM IS FOUND
GO TO 8721
1722 CONTINUE
C CAN'T USE SLASH FOR REPEAT AFTER @Q
8721 V(I)=NLIT
ILIT=I
DO 9721 K=JC,JD
C PUTS ITEM IN "IV" ARRAY
I=I+1
9721 IV(I)=INP(K)
I=I+1
27222 IF(IAMP.EQ.0)GO TO 1299
2722 V(I)=999.
1042 QTS=-1.
CODE=-88.
C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
IF(LPAR.EQ.2)CALL ERR(13)
C NO 'LIT' WITH P2!!
V(IJ+1)=CODE+SUB
V(IJ)=(I-IJ+1)*ALL
IJ=IJ+2
V(IJ)=IJ+1
I=I+1
ISUB=1
GO TO 1299
7720 V(I)=INSNUM
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
IF(JRSTA.EQ.0)CALL SCANR
IF(VX1.EQ.0)VX1=INSNUM-1
C DUPL 0; = DUPL PREV. INST. NUM
V(I+3)=VX1
I=I+4
L=VX1
IF(NP(INSNUM).LT.NP(L))NP(INSNUM)=NP(L)
IF(JRSTA.NE.0)GO TO 2173
C GO BACK IF THIS WAS AN AUTOMATIC 'DUPL' WITH A 'RESTART' (DUR IS DIFFERENT)
IF(DUR(INSNUM).LT.0)DUR(INSNUM)=DUR(L)
CXXXXXXX IF(JRSTA.NE.0)GO TO 2173
CXXXXXXXC GO BACK IF THIS WAS AN AUTOMATIC 'DUPL' WITH A 'RESTART'
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
142 FORMAT(I,15A5)
1301 FORMAT(15A5)
1302 FORMAT(1X15A5)
300 FORMAT(I,3F,A1)
301 FORMAT(3F,A1)
6 IF(J.NE.'PRECE')GO TO 1341
C 'PRECEDE' WRITES LINES DIRECTLY ON DSK, BEFORE THE WORD 'PLAY;'.
C NO LIMIT TO THE NUMBER OF LINES. LAST LINE (NOT PRINTED) MUST
C BEGIN WITH *. KNP ARRAY (15) IS EQUIV. TO INP .
4341 IF(ITYP)GO TO 5341
TYPE 2203
ACCEPT 1301,KNP
CALL SHORT(KNP,K)
WRITE(21,1301)(KNP(JD),JD=1,K)
GO TO 6341
5341 IF(LN.EQ.0)GO TO 2341
READ(23,142,END=7341)K,KNP
GO TO 3341
7341 CALL ERR(10)
C GO TO ERROR ROUTINE IF MISSING "*".
STOP
2341 READ(23,1301,END=7341)KNP
3341 CALL SHORT(KNP,K)
C DON'T TYPE TRAILING BLANKS
IF(MX.EQ.22)GO TO 6341
IF(SOS)TYPE 1302,(KNP(JD),JD=1,K)
6341 IF(MX.EQ.22)WRITE(JOUT,1302)(KNP(JD),JD=1,K)
IF(KNP(1).EQ.IASTR)GO TO 2308
IF(MX)WRITE(1,1301)(KNP(JD),JD=1,K)
GO TO 4341
1341 KB=KB+1
IF(JED.GT.0)JED=0
IF(J.EQ.'INSER')GO TO 1340
OTH(KB,1)=VX1*100000.+VX2*100.+VX3
GO TO 340
1340 X=VX1
IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
OTH(KB,1)=X
GO TO 1338
C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
C - BEGIN LINE WITH <,END WITH ;
C UP TO 75 CHARACTERS MAY BE TYPED.
340 IF(VX3.NE.2)GO TO 1338
IF(ITYP.GE.0)GO TO 449
CC JREAD=5
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
445 OTH(KB,3)=1.
CC IF(IFI.GE.0)GO TO 447
IF(LN.EQ.0)GO TO 447
REREAD 300,K,OTH(KB,2)
GO TO 1447
447 REREAD 301,OTH(KB,2)
1447 IF(JED)GO TO 2308
3445 TYPE 2202
ACCEPT 77732,K
CALL LO2UP(K)
IF(K.EQ.IG)JED=-1
IF(J.EQ.'INSER')GO TO 3446
IF(K.NE.'Y')GO TO 2308
IF(JED)GO TO 2308
449 TYPE 2203
ACCEPT 301,OTH(KB,2)
IF(JED)WRITE(21,301) OTH(KB,2)
GO TO 2308
1338 IF(ITYP.GE.0)GO TO 1449
CC JREAD=6
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
446 IF(LN.EQ.0)GO TO 448
REREAD 142,K,(OTH(KB,JD),JD=2,16)
GO TO 1446
448 REREAD 1301,(OTH(KB,JD),JD=2,16)
1446 IF(JED)2446,3445,2446
3446 IF(K.NE.LY)GO TO 2446
IF(JED)GO TO 2446
1449 TYPE 2203
ACCEPT 1301,(OTH(KB,JD),JD=2,16)
IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446 X=OTH(KB,2)
IF(J.NE.INSER)GO TO 971
IF(VX3.EQ.0)GO TO 971
IF(X.NE.ASTR)GO TO 6
971 IF(X.EQ.ASTR)KB=KB-1
C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C LAST LINE HAS '*' IN COLUMN 1.
GO TO 2308
C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C INSERT MAY INCLUDE 10 CHARS(P3-P30),
C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C BX=INST N. Y=NOTE N. Z=PARAM N.
1106 KTMP=1
IAMP=0
BW=BY
ITMP=-1
ISUB=5
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2
V(I+4)=VX3
I=I+5
BY=BW
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
CALL BGSORT(BW)
9003 IF(IAMP)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
5 IF(VX2.NE.0)GO TO 105
C 'TEMPO/120;' OR 'TEMPO/1.5 72;' IS OK.
VX2=VX1
VX1=0
105 IF(VX2.GE.12.)VX2=VX2/60.
C TEMPO < 12 = A FACTOR, ≥12 = MM. NUM.
IF(VX3.GE.12.)VX3=VX3/60.
IF(VX3.EQ.0)VX3=VX2
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C MM CAN BE FROM 11 UP TEMPO FACTOR FROM 10 DOWN.
C UP TO 30 TEMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE+SUB
ISUB=3
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
103 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.KSLA)GO TO 1014
IF(K.EQ.ISEMI)GO TO 1014
1010 IF(K.NE.IBLA) GO TO 1899
1011 ML=ML+1
GO TO 103
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.EQ.-22.)GO TO 2017
IF(CODE.LT.-23)GO TO 17
IF(IZ/2*2.EQ.IZ)GO TO 17
C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017 IF(VX1.LT.-9999.)GO TO 3017
IF(VX1.NE.0)VX1=4./VX1
C RHYTHMIC INPUT OF 0 GIVES 0 DURATION REST!!!
IF(JJ.NE.1)GO TO 2014
3017 V(I)=VX1
GO TO 114
1217 IF(VX1.EQ.-10000.)GO TO 114
C FOR "FINE" IN LIST
V(I+1)=VX2
IF(CODE.EQ.-36.)CALL RANR(V,I)
2217 I=I+1
C SETS UP STRING OF RAND SELECTIONS
GO TO 114
3217 V(I)=V(I-2)
V(I+1)=RB
C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 IF(ICHD.EQ.0)GO TO 4014
JJ=1
C SETS UP NEXT NOTE AS CHORD (THIS ONE BECOMES NEG.)
VX1=-VX1
C FOR CHORD FEATURE
ICHD=0
4014 V(I)=VX1
IF(CODE.EQ.-46.)GO TO 1217
IF(CODE.EQ.-36.)GO TO 1217
IF(CODE.NE.-35)GO TO 972
C****************** 8/78 IF(VX1.GT.15)CALL ERR(4)
C FINDS F NUM.>15!
C JUMP IF STRING OF RAND SELECS.
972 IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 IF(CODE.EQ.-46.)GO TO 3217
IF(CODE.EQ.-36.)GO TO 3217
IF(CODE.NE.-33)GO TO 1103
IF(V(I-2).GE.0)GO TO 1103
C NEXT FOR SLASH REPEAT OF CHORD
JC=1
JD=1
GO TO 2103
1103 V(I)=RB
C RB SAVES IT FOR SLASH REPEAT
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C********* MAY 19,71 ----MANY LINES ABOVE.
2103 IZ=IZ+JC*JD
C JD=HOW MANY TIMES, JC=HOW MANY NOTES
IF(CODE.NE.-33)GO TO 3103
8103 N=0
V(IA-1)=0
DO 4103 K=I-1,1,-1
IF(V(K).GE.0)GO TO 7103
IF(V(K).GT.-9999.0)GO TO 4103
C NEG. NUMBS USUALLY ARE CHORD NOTES, -9999.N IS SECONDARY PARAM.
7103 N=N+1
4103 IF(N.EQ.JC)GO TO 5103
5103 IF(V(K-1).GE.0)GO TO 6103
IF(V(K).EQ.0)GO TO 6103
K=K-1
GO TO 5103
6103 JC=I-K
3103 DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
C RB SAVES DATA FOR SLASH REPEAT FEATURE.
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
IZ=IZ-1
KA=1
IC=1
K=0
J=1
Z=0
RC=0
9007 Y=PCH(3,IC)
X=PCH(2,IC)
Z=PCH(1,IC)
CALL SQYY(YY,X,Y,Z)
XT(1)=X
PR=RA
ZZ=Z
CALL ACCEL
IF(K.EQ.IZ)GO TO 3013
IF(RA.NE.-10000.)GO TO 9007
3013 X=I-IJ
V(IJ+2)=X-3.
V(IJ)=X*ALL
IF(CODE.NE.-35)GO TO 4773
M=IJ+3
C SETS NUMBERS FOR FUNCS.
DO 313 K=M,I-1
X=V(K)
IF(X.LT.-9999.)GO TO 313
CATCHES 'FINE'(-10000), F1-F99 ONLY PLEASE. USE NEG. FOR REST IN FUNC LIST.
V(K)=X+200.
IF(X.LT.0)V(K)=199.
313 CONTINUE
GO TO 4773
END